perm filename PPITCH.SAI[4,ALS] blob
sn#202976 filedate 1976-02-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "PITCH"
C00007 ENDMK
C⊗;
BEGIN "PITCH"
DEFINE ⊂="COMMENT"; ⊂ AUG.2,1973;
INTEGER I,J,K,L,M,N,P,Q,R,POINTX,POINTY,STATE,DELTA,VAL,CHAN1,EOF;
INTEGER II,JJ,P1,P2,P3,T1,T2,T3,T,DT,H,TAU1,TAU2;
INTEGER ARRAY BUF,PITCH[0:1000];
STRING FILEN,READ,READ1,FILEO,READ2;
DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
⊂ Three peaks are located, then tests are made on the middle
one to determine whether it should be reported or discarded;
⊂ These peaks are P1, P2, and P3 with corresponding times of T1, T2 and T3;
⊂ The conditions for discarding are
a) just getting started, P1=0
b) the middle peak is definitely smaller than one at the ends
c) the time interval between P1 and P2 is too small
d) the time interval is too large;
FILEN←"FLTD.001[DAT,NJM]";
OUTSTR("Type file name (CR for "&FILEN&".");
IF (READ←INCHWL)≠"" THEN FILEN←READ ELSE READ←FILEN;
READ1←""; FOR I←0 STEP 1 UNTIL 6 DO BEGIN
READ2←READ[1 TO 1]; READ1←READ1&READ2; READ←READ[2 TO 6];
IF READ2="." THEN DONE; END;
FILEO←READ1&"PCH";
POINTY←POINT(12,PITCH[0],-1);
TAU1←40;
OUTSTR("Set TAU1 (CR for 40) ");IF (READ←INCHWL)≠"" THEN TAU1←CVD(READ);
TAU2←140;
OUTSTR("Set TAU2 (CR for 140) ");IF (READ←INCHWL)≠"" THEN TAU2←CVD(READ);
DELTA←1200;
OUTSTR("Type value for DELTA (CR for 1200) ");
IF (READ←INCHWL)≠"" THEN DELTA←CVD(READ);
CHAN1←1; CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
LOOKUP(CHAN1,FILEN,0);
J←K←L←STATE←VAL←R←0;
OUTSTR(CRLF&"Pitch measure on file "&FILEN &CRLF&LF);
OUTSTR(" T P A T P A T P A T P A"&CRLF&LF);
SETFORMAT(4,0); P←P1←P2←P3←T1←T2←T3←H←Q←0;
WHILE EOF=0 DO BEGIN
FOR J←0 STEP 1 UNTIL 1000 DO BUF[J]←0;
ARRYIN(CHAN1,BUF[0],1000);
POINTX←POINT(12,BUF[0],-1);
FOR I←0 STEP 1 UNTIL 2999 DO BEGIN
L←K*1500+I%2;
VAL←ILDB(POINTX); IF VAL>2047 THEN VAL←VAL-4096;
IF H>0 THEN IF VAL≤0 THEN IF L-T3>6 THEN T←L;
IF VAL>0 THEN IF H≤0 THEN BEGIN
WHILE TRUE DO BEGIN
IF P<P3 THEN DONE;
⊂ IF L-T<6 THEN DONE;
IF P1<DELTA THEN BEGIN
P1←P2; T1←T2; P2←P; T2←T3; DONE END;
IF T2-T1>TAU2 THEN BEGIN
P1←P2; T1←T2; P2←P; T2←T3; DONE END;
IF P2<DELTA THEN BEGIN
P2←P; T2←T3; DONE END;
IF T2-T1<TAU1 THEN BEGIN
IF P2>P1 THEN BEGIN
P1←P2; T1←T2; P2←P; T2←T3; DONE END ELSE BEGIN
P2←P; T2←T3; DONE END; END;
IF P2<P1 THEN IF P2<P THEN IF T3-T1<TAU2 THEN BEGIN
P2←P; T2←T3; DONE END;
OUTSTR(CVS(T1%10)&CVS(T2-T1)&CVS(P1 LSH -9)&" ");
IF (R MOD 4)=3 THEN BEGIN OUTSTR(CRLF); R←0; END ELSE R←R+1;
TAU1←(2*TAU1+2*(T2-T1))%5;
IF TAU1<40 THEN TAU1←40;
TAU2←(4*TAU2+T2-T1) LSH -2;
IF TAU2>140 THEN TAU2←140;
Q←Q+1;
IDPB(T1%100,POINTY); IDPB(T2-T1,POINTY); IDPB((P1 LSH -9),POINTY);
P1←P2; T1←T2; P2←P; T2←T3; DONE END;
P3←P; T3←L; P←0; END;
H←VAL;
IF VAL>0 THEN P←P+VAL ELSE P←P-VAL;
END;
K←K+1;
END;
CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,0);
ENTER(CHAN1,FILEO,0);
ARRYOUT(CHAN1,PITCH[0],Q); RELEASE(CHAN1);
END "PITCH";